perm filename GAME.JMC[206,LSP]1 blob sn#379040 filedate 1978-09-05 generic text, type T, neo UTF8
(DEFPROP GAME
         (VALMAX
	  VALMIN
	  LINEMAX
	  LINEMIN
	  TREEMAX
	  TREEMIN
	  RECTIFY
	  COMMONTAIL
	  COMMONHEAD
	  TRYJMC)
FNS)

(DEFPROP VALMAX
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) ALPHA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA))
		  (VALMAX (CDR U) ALPHA BETA))
		 ((LESSP S BETA) (VALMAX (CDR U) S BETA))
		 (T BETA)))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP VALMIN
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) BETA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA)) ALPHA)
		 ((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
		 (T (VALMIN (CDR U) ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP LINEMAX
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS ALPHA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA))
		  (LINEMAX (CDR U) LINE ALPHA BETA))
		 ((LESSP (CAR S) BETA)
		  (LINEMAX (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   (CAR S)
			   BETA))
		 (T (CONS BETA LINE))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMIN (SUCCESSORS (CAR U))
			  (CONS BETA (QUOTE BETA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP LINEMIN
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS BETA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
		 ((LESSP (CAR S) BETA)
		  (LINEMIN (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   ALPHA
			   (CAR S)))
		 (T (LINEMIN (CDR U) LINE ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMAX (SUCCESSORS (CAR U))
			  (CONS ALPHA (QUOTE ALPHA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP TREEMAX
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST ALPHA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(TREEMAX (CDR U)
		 TRMAX
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 ALPHA
		 BETA))
       ((LESSP (CAR S) BETA)
	(TREEMAX (CDR U)
		 (CONS (EXT (CAR U)) (CADR S))
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 (CAR S)
		 BETA))
       (T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMIN (SUCCESSORS (CAR U))
		NIL
		(CONS BETA (QUOTE BETA-CUTOFF))
		ALPHA
		BETA)))))))
EXPR)

(DEFPROP TREEMIN
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST BETA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
       ((LESSP (CAR S) BETA)
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 (CONS (EXT (CAR U)) (CADDR S))
		 ALPHA
		 (CAR S)))
       (T
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 TRMIN
		 ALPHA
		 BETA))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMAX (SUCCESSORS (CAR U))
		(CONS ALPHA (QUOTE ALPHA-CUTOFF))
		NIL
		ALPHA
		BETA)))))))
EXPR)

(DEFPROP RECTIFY
 (LAMBDA(P)
  (PROG	(Z Q)
	(SETQ Q (COMMONTAIL P P1))
   L1	(COND ((EQUAL Q P1) (GO L2)))
	(REVERT)
	(GO L1)
   L2	(SETQ Z (LISTSUBT P P1))
   L3	(COND ((NULL Z) (RETURN P)))
	(UPDATE (CAR Z))
	(SETQ Z (CDR Z))
	(GO L3)))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)

(DEFPROP COMMONHEAD
 (LAMBDA(U V)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
	(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)


(DEFUN TRYJMC (MODE WW POS)
  (PROG ()
    (NEWGAME)
    (SETQ W WW)
    (MAPC (FUNCTION UPDATE) (REVERSE POS))
    (PRINTBOARD)
    (PRINT 
	(COND ((EQ MODE 'VAL)
	      (COND (W (VALMIN (SUCCESSORS P1) -1000 1000)) 
		    (T (VALMAX (SUCCESSORS P1) -1000 1000))))
	      ((EQ MODE 'LINE)
	      (COND (W (LINEMIN (SUCCESSORS P1) NIL -1000 1000)) 
		    (T (LINEMAX (SUCCESSORS P1) NIL -1000 1000))))
	      ((EQ MODE 'TREE)
	      (COND (W (TREEMIN (SUCCESSORS P1) NIL NIL -1000 1000)) 
		    (T (TREEMAX (SUCCESSORS P1) NIL NIL -1000 1000)))) )
	) ))


(DEFPROP GAMEXX
 (VMX LMX TMX)
FNS)

(DEFPROP VMX
 (LAMBDA (P) (RECTIFY P) (COND (W (VALMIN (SUCCESSORS P) -1000 1000)) (T (VALMAX (SUCCESSORS P) -1000 1000))))
EXPR)

(DEFPROP LMX
 (LAMBDA(P)
  (RECTIFY P)
  (COND (W (LINEMIN (SUCCESSORS P) NIL -1000 1000)) (T (LINEMAX (SUCCESSORS P) NIL -1000 1000))))
EXPR)

(DEFPROP TMX
 (LAMBDA(P)
  (RECTIFY P)
  (COND (W (TREEMIN (SUCCESSORS P) NIL NIL -1000 1000)) (T (TREEMAX (SUCCESSORS P) NIL NIL -1000 1000))))
EXPR)